home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / jpegvu / jpegvu.bas < prev    next >
Encoding:
BASIC Source File  |  1996-06-29  |  3.8 KB  |  97 lines
  1. Attribute VB_Name = "JPEGBASIC"
  2. Type BITMAPINFOHEADER '40 bytes
  3.         biSize As Long
  4.         biwidth As Long
  5.         biheight As Long
  6.         biPlanes As Integer
  7.         biBitCount As Integer
  8.         biCompression As Long
  9.         biSizeImage As Long
  10.         biXPelsPerMeter As Long
  11.         biYPelsPerMeter As Long
  12.         biClrUsed As Long
  13.         biClrImportant As Long
  14. End Type
  15.  
  16. Type BITMAPINFO   'Varies
  17.         bmiHeader As BITMAPINFOHEADER
  18.         bmiColors As String * 256 ' Array length is arbitrary; may be changed
  19. End Type
  20.  
  21. Declare Function rfile Lib "c:\windows\system\imglib16.dll" Alias "ReadFileIntoDIB" (ByVal st As String) As Long
  22. Declare Function BITMHead Lib "c:\windows\system\Dibinfo.dll" (ByVal ldib As Long, lpinfo As BITMAPINFO) As Long
  23. Declare Sub DIBFree Lib "c:\windows\system\imglib16.dll" (ByVal ldib As Long)
  24. Declare Function CreateDIBitmap Lib "GDI" (ByVal hDC As Integer, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, ByVal lpInitBits As Long, lpInitInfo As BITMAPINFO, ByVal wUsage As Integer) As Integer
  25. Declare Function DeleteObject Lib "GDI" (ByVal hDC As Integer) As Integer
  26. Declare Function CreateCompatibleDC Lib "GDI" (ByVal hDC As Integer) As Integer
  27. Declare Function DeleteDC Lib "GDI" (ByVal hDC As Integer) As Integer
  28. Declare Function StretchBlt% Lib "GDI" (ByVal hDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwrop&)
  29. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal x%)
  30.  
  31.  
  32. Global Const CBM_INIT = &H4&
  33. Global bih As BITMAPINFOHEADER
  34. Global bi As BITMAPINFO
  35. Global ldib As Long
  36. Global lbits As Long
  37. Global nam$
  38. Global jpegnum
  39.  
  40.  
  41.  
  42.  
  43. Public Sub displayjpeg()
  44. nam$ = "c:\vb\kimdog.jpg"
  45. 'nam$ is name of 24 bit jpeg file to display
  46.  
  47. 'main DLL, imglib.dll takes JPEG file nam$, decodes it and stores it as
  48. 'a Device Independent Bitmap ie a DIB
  49.     ldib = rfile(nam$)
  50.  
  51. 'second DLL,dibinfo.dll extracts the BITMAPINFO from the DIB
  52. 'that is the size of the image x and y number of colours etc
  53.     lbits = BITMHead(ldib, bi)
  54.  
  55. 'print on screen DIB diagnostic information
  56.     Form1.Picture1.CurrentX = 0
  57.     Form1.Picture1.CurrentY = 0
  58.     Form1.Picture1.Print "dib "; ldib
  59.     Form1.Picture1.Print "return "; lbits
  60.  
  61. 'extract a subset of image info, the BITMAPHEADERINFO
  62. 'from the BITMAPINFO
  63.     LSet bih = bi.bmiHeader
  64.  
  65. 'print on screen the JPEG image information
  66.     Form1.Picture2.CurrentX = 0
  67.     Form1.Picture2.CurrentY = 0
  68.     Form1.Picture2.Print "size  "; bih.biSize
  69.     Form1.Picture2.Print "width  "; bih.biwidth
  70.     Form1.Picture2.Print "height  "; bih.biheight
  71.     Form1.Picture2.Print "number planes"; bih.biPlanes
  72.     Form1.Picture2.Print "bits/colour  "; bih.biBitCount
  73.     Form1.Picture2.Print "compression  "; bih.biCompression
  74.     Form1.Picture2.Print "bit size image  "; bih.biSizeImage
  75.     Form1.Picture2.Print "x pixels/metre  "; bih.biXPelsPerMeter
  76.     Form1.Picture2.Print "y pixels/metre  "; bih.biYPelsPerMeter
  77.     Form1.Picture2.Print "colours used  "; bih.biClrUsed
  78.     Form1.Picture2.Print "colour important  "; bih.biClrImportant
  79.  
  80. 'go through process of displaying image on Form1
  81.     du% = CreateDIBitmap(Form1.hDC, bih, CBM_INIT, lbits, bi, 0)
  82.     DIBFree (ldib) 'free up DIB memory ready for next JPEG image
  83.     hm% = CreateCompatibleDC(Form1.hDC)
  84.     holdmap% = SelectObject(hm%, du%)
  85.     src& = &HCC0020 ' constant needed for Stretchblit
  86.     'main display Windows API function
  87.     m% = StretchBlt%(Form1.hDC, 90, 30, 400, 300, hm%, 0, 0, bih.biwidth, bih.biheight, src&)
  88.     dummy% = SelectObject(hm%, holdmap%)
  89.     dummy% = DeleteObject(du%)
  90.     dummy% = DeleteDC(hm%)
  91.     
  92.     Form1.Picture3.Print du% 'diagnostics
  93.     Form1.Picture3.Print holdmap% 'diagnostics
  94.     Form1.Picture3.Print m% 'diagnostics
  95.  
  96. End Sub
  97.